home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 090 / toolfix.arc / SORT1.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1985-08-07  |  3.5 KB  |  130 lines
  1. {$C-}
  2. program SortAFile;
  3. {
  4.   TURBO DATABASE TOOLBOX DEMONSTRATION PROGRAM:
  5.  
  6.   Demonstrates how to sort a file of records.
  7.  
  8.   Modified:  08/07/85
  9.  
  10.   This program takes the CUSTOMER.DTA file, sorts the the records by
  11.   the Number field, and displays the sorted records on the screen.
  12. }
  13.  
  14. type
  15.   NameString = string[25];
  16.   CustRec = record
  17.               Number: integer;
  18.               Name:   NameString;
  19.               Addr:   string[20];
  20.               City:   string[12];
  21.               State:  string[3];
  22.               Zip:    string[5];
  23.             end;
  24.   CustFileType = file of CustRec;
  25.  
  26. var
  27.   CustFile : CustFileType;
  28.   Customer : CustRec;
  29.   Results  : integer;
  30.  
  31. {$I SORT.BOX }
  32.  
  33. procedure OpenFile(var f : CustFileType; Name : NameString);
  34. { Display welcome screen, open data file }
  35. begin
  36.   ClrScr;
  37.   Writeln('TURBO-SORT DEMONSTRATION PROGRAM');
  38.   Writeln;
  39.   Writeln('Opening data file');
  40.   Assign(f, Name);
  41.   {$I-}
  42.   Reset(f);
  43.   {$I+}
  44.   if IOresult <> 0 then
  45.   begin
  46.     Writeln(^G, '  -- Cannot find ', Name);
  47.     Halt;                                { abort program }
  48.   end;
  49. end; (* OpenFile *)
  50.  
  51. procedure Inp;
  52. { This procedure is forward declared in SORT.BOX.  It sends a stream
  53.   of records to the sort routine.
  54. }
  55. var
  56.   rec : integer;   { # of records read from data file }
  57. begin
  58.   rec := 0;
  59.   Writeln;
  60.   Writeln('Input routine -- sending ', FileSize(CustFile),
  61.           ' records to sort:');
  62.   repeat
  63.     rec := rec + 1;
  64.     Write(#13, rec:6);
  65.     Read(CustFile,Customer);
  66.     SortRelease(Customer);
  67.   until EOF(CustFIle);
  68.   Writeln;
  69.   Writeln;
  70.   Writeln('Done with input -- sorting ',
  71.            FileSize(CustFile), ' records . . .');
  72. end; { Inp }
  73.  
  74. function Less;
  75. { This boolean function is forward declared in SORT.BOX and has
  76.   two parameters, X and Y.   Because this function is called so
  77.   often,  the number of  statements in this  function should be
  78.   kept to a minimum.
  79. }
  80. var
  81.   FirstCust:  CustRec absolute X;
  82.   SecondCust: CustRec absolute Y;
  83. begin
  84.   Less := FirstCust.Number < SecondCust.Number;  { define sort order }
  85. end; { Less }
  86.  
  87. procedure OutP;
  88. { This procedure is forward declared in SORT.BOX.  It
  89.   retrieves the sorted objects one-by-one.
  90. }
  91. var
  92.   i : integer;
  93. begin
  94.   repeat
  95.     if KeyPressed then Halt;            { Key touched?  Stop program }
  96.     SortReturn(Customer);
  97.     with Customer do
  98.     begin
  99.       Write(Number, ' ', Name,' ');
  100.       for i := Length(Name) to 25 do Write(' ');
  101.       Write(Addr);
  102.       for i := Length(Addr) to 20 do Write(' ');
  103.       Write(City);
  104.       for i := Length(City) to 12 do Write(' ');
  105.       Writeln(State,' ', Zip);
  106.     end; { with }
  107.   until SortEOS;
  108. end; (* OutP *)
  109.  
  110. procedure DisplayResults(results : integer);
  111. begin
  112.   Writeln;
  113.   Writeln;
  114.   case Results of                         { display sort results     }
  115.      0 : Writeln('Done with sort and display.');
  116.      3 : Writeln('Error:  not enough memory to sort');
  117.      8 : Writeln('Error:  illegal item length.');
  118.      9 : Writeln('Error:  can only sort ', MaxInt, ' records.');
  119.     10 : Writeln('Error:  disk full or disk write error.');
  120.     11 : Writeln('Error:  disk error during read.');
  121.     12 : Writeln('Error:  directory full or invalid path name');
  122.   end; (* case *)
  123. end; (* DisplayResults *)
  124.  
  125. begin { program body }
  126.   OpenFile(CustFile, 'CUSTOMER.DTA');     { open data file to sort   }
  127.   Results := TurboSort(SizeOf(CustRec));  { sort the file of records }
  128.   DisplayResults(Results);                { display sort results     }
  129. end.
  130.